Lista 4: Teoria de Vis
Germano Andrade Brandão - 2017080008
19/05/2020
Problema 1: The Economist
Crie o último gráfico do link https://tutorials.iq.harvard.edu/R/Rgraphics/Rgraphics.html. Este é um gráfico que apresenta uma relação entre o IDH x IPC entre diversos países.
Resposta:
Começando com um simples gráfico de dispersão:
dat <- read.csv("C:/Graduação - Data Science/Análise Explorátoria de Dados e Visualização/Lista 4/Rgraphics/dataSets/EconomistData.csv")
pc1 <- ggplot(dat, aes(x = CPI, y = HDI, color = Region))
pc1 + geom_point()
Adicionando uma linha de tendência:
pc2 <- pc1 +
geom_smooth(mapping = aes(linetype = "r2"), #Aqui é usado o coeficiente de determinação(r^2) para o tipo da linha.
method = "lm",
formula = y ~ x + log(x), se = FALSE,
color = "red")
#Nesse ponto, foi alterado a forma dos pontos, para que virassem uma circunferência e modificado os seus tamanhos e a espessura das bordas.
(pc3 <- pc2 + geom_point(shape = 1, size = 2.5, stroke = 1.25))
Escolhendo os pontos que devem aparecer no gráfico:
#Agora, baseando-se no gráfico original, foi selecionado os países que vão ser destacados frente aos demais, e então foram guardados em uma variável.
pointsToLabel <- c("Russia", "Venezuela", "Iraq", "Myanmar", "Sudan",
"Afghanistan", "Congo", "Greece", "Argentina", "Brazil",
"India", "Italy", "China", "South Africa", "Spane",
"Botswana", "Cape Verde", "Bhutan", "Rwanda", "France",
"United States", "Germany", "Britain", "Barbados", "Norway", "Japan",
"New Zealand", "Singapore")#Detalhe para a função 'filter' da biblioteca "dplyr" que é usado para adicionar ao gráfico apenas os países que estiverem na variável 'pointsToLabel' criada há pouco.
#Além disso, foi utilizada nesse ponto a biblioteca "ggrepel" para corrigir a posição do nome dos países que estavam gerando conflito no gráfico.
(pc4 <- pc3 +
geom_text_repel(aes(label = Country),
color = "gray20",
data = filter(dat, Country %in% pointsToLabel),
force = 10))
Mudar a ordem e o rótulo da região:
dat <- read.csv("C:/Graduação - Data Science/Análise Explorátoria de Dados e Visualização/Lista 4/Rgraphics/dataSets/EconomistData.csv")
#Foi alterada dentro da tabela o nome de cada região e o nível de ordem (já que a variáve região é do tipo 'factor').
dat$Region <- factor(dat$Region,
levels = c("EU W. Europe",
"Americas",
"Asia Pacific",
"East EU Cemt Asia",
"MENA",
"SSA"),
labels = c("OECD",
"Americas",
"Asia &\nOceania",
"Central &\nEastern Europe",
"Middle East &\nnorth Africa",
"Sub-Saharan\nAfrica"))#Nesse ponto o que se faz é "atualizar" os dados do gráfico, uma vez que eles foram modificados. O 'pc4' havia herdado desde o 'pc1' o "ggplot(data = dat,...)", então foi preciso colocar o 'dat' modificado sem precisar repetir todo o processo.
pc4$data <- dat
pc4
#Adicionado a biblioteca "grid"
(pc5 <- pc4 +
scale_x_continuous(name = "Corruption Perceptions Index, 2011 (10=least corrupt)",
limits = c(.9, 10.5),
breaks = 1:10) +
scale_y_continuous(name = "Human Development Index, 2011 (1=Best)",
limits = c(0.2, 1.0),
breaks = seq(0.2, 1.0, by = 0.1)) +
scale_color_manual(name = "",
values = c("#24576D",
"#099DD7",
"#28AADC",
"#248E84",
"#F2583F",
"#96503F")) +
ggtitle("Corruption and Human development"))
(pc6 <- pc5 +
theme_minimal() + # start with a minimal theme and add what we need
theme(text = element_text(color = "gray20"),
legend.position = c("top"), # position the legend in the upper left
legend.direction = "horizontal",
legend.justification = 0.1, # anchor point for legend.position.
legend.text = element_text(size = 11, color = "gray10"),
axis.text = element_text(face = "italic"),
axis.title.x = element_text(vjust = -1), # move title away from axis
axis.title.y = element_text(vjust = 2), # move away for axis
axis.ticks.y = element_blank(), # element_blank() is how we remove elements
axis.line = element_line(color = "gray40", size = 0.5),
axis.line.y = element_blank(),
panel.grid.major = element_line(color = "gray50", size = 0.5),
panel.grid.major.x = element_blank()
))
Problema 2: Minard
Reproduza o gráfico de Minard que representa a jornada do lider político Napoleão ao levar seu exército para a Campanha Russa. O tutorial se encontra em https://www.andrewheiss.com/blog/2017/08/10/exploring-minards-1812-plot-with-ggplot2/.
Resposta:
Minard
cities <- read.table("cities.txt",
header = TRUE, stringsAsFactors = FALSE)
troops <- read.table("troops.txt",
header = TRUE, stringsAsFactors = FALSE)
#A função 'mutate' foi usada para colocar a data em um formato adequado, sinalizando que possui dia, mês e ano (dmy).
temps <- read.table("temps.txt",
header = TRUE, stringsAsFactors = FALSE) %>%
mutate(date = dmy(date))- Uma breve analisada na tabela troops nos mostra que ela contém dados geográficos das cidades(latitude e longitude), número de sobreviventes, o grupo que passava por aqueles lugares e a indicação do grupo.
kable(head(troops), align = 'c')| long | lat | survivors | direction | group |
|---|---|---|---|---|
| 24.0 | 54.9 | 340000 | A | 1 |
| 24.5 | 55.0 | 340000 | A | 1 |
| 25.5 | 54.5 | 340000 | A | 1 |
| 26.0 | 54.7 | 320000 | A | 1 |
| 27.0 | 54.8 | 300000 | A | 1 |
| 28.0 | 54.9 | 280000 | A | 1 |
#Apenas mapeando os pontos através de linhas e agrupando pelos diferentes grupos da tropa, já obtemos algo parecido com o gráfico final:
ggplot() +
geom_path(data = troops, aes(x = long, y = lat, group = group))
ggplot() +
geom_path(data = troops, aes(x = long, y = lat, group = group, color = direction, size = survivors))
#Como o final de linha (lineend) padrão do 'geom_path' é do tipo "butt", aparecem algumas falhas em partes das linhas. Para solucionar esse problema, o 'lineend' é alterado:
(p1 <- ggplot() + geom_path(data = troops, aes(x = long, y = lat, group = group, color = direction, size = survivors), lineend = "round"))
#Para aumentar a espessura da linha -que varia de acordo com o número de sobreviventes-, altera-se a escala usada para tal:
(p2 <- p1 +
scale_size(range = c(0.5, 10)))
- Agora que o gráfico está se assemelhando mais ainda do original, desconsiderando a cor, vamos tratar de pequenos detalhes para que fique ainda mais parecido.
(p3 <- p2 +
scale_colour_manual(values = c("lightgoldenrod3", "gray13")) +
labs(x = NULL, y = NULL) +
guides(color = FALSE, size = FALSE))
#Vamos adicionar as cidades e seus respectivos nomes:
(p4 <- p3 +
geom_point(data = cities, aes(x = long, y = lat), color = "tomato") +
geom_text_repel(data = cities, aes(x = long, y = lat, label = city), color = "tomato") +
theme_void())
- Agora, por curiosidade, vamos utilizar os recursos da biblioteca “ggmap” para colocar nosso gráfico em um mapa real. Isso porque o nosso gráfico contém as coordenadas geográficas reais das cidades.
march.1812.ne.europe <- c(left = 23.5, bottom = 53.4, right = 38.1, top = 56.3)
march.1812.ne.europe.map <- get_stamenmap(bbox = march.1812.ne.europe, zoom = 8,
maptype = "terrain-background", where = "cache")(march.1812.plot <- ggmap(march.1812.ne.europe.map) +
geom_path(data = troops, aes(x = long, y = lat, group = group, color = direction, size = survivors), lineend = "round") +
scale_size(range = c(0.5, 10)) +
scale_colour_manual(values = c("lightgoldenrod3", "gray13")) +
guides(color = FALSE, size = FALSE) +
theme_nothing() +
geom_point(data = cities, aes(x = long, y = lat), color = "mediumvioletred") +
geom_text_repel(data = cities, aes(x = long, y = lat, label = city), color = "mediumvioletred"))
Vamos adicionar as temperaturas ao gráfico.
(t1 <- ggplot(temps, aes(long, temp)) +
geom_path(color="grey", size=1.5) +
geom_point(size=1.5, color = "tomato"))
- Aqui, vamos utilizar a função ‘mutate’ da biblioteca “dplyr” para adicionar uma coluna chamada ‘label’ à base de dados das temperaturas, que vai conter as temperaturas na forma que devem aparecer no gráfico;
temps <- mutate(temps, label = paste0(temp, ".° le ", month, " ", day))- Vejamos o resultado;
kable(select(head(temps),temp, date, label), col.names = c("Temperatura", "Data", "label"), align = 'c')| Temperatura | Data | label |
|---|---|---|
| 0 | 1812-10-18 | 0.° le Oct 18 |
| 0 | 1812-10-24 | 0.° le Oct 24 |
| -9 | 1812-11-09 | -9.° le Nov 9 |
| -21 | 1812-11-14 | -21.° le Nov 14 |
| -11 | 1812-11-24 | -11.° le Nov 24 |
| -20 | 1812-11-28 | -20.° le Nov 28 |
(t2 <- t1 +
geom_label(aes(label=temps$label), color = "white", fill = "tomato", size=2.6, nudge_y = 2))
(t3 <- t2 +
coord_cartesian(xlim = c(24, 38), ylim = c(-35, 5)) +
labs(x = NULL, y="° Celsius") +
scale_y_continuous(position = "right") +
theme_bw() +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
axis.text.x = element_blank(), axis.ticks = element_blank(),
panel.border = element_blank()))
Gráfico final
grid.arrange(p4, t3, nrow=2, heights=c(3.5, 1.2))
grid.rect(width = .99, height = .99, gp = gpar(lwd = 2, col = "turquoise4", fill = NA))
Problema 3: Gapminder
Faça a animação presente em https://towardsdatascience.com/how-to-build-animated-charts-like-hans-rosling-doing-it-all-in-r-570efc6ba382 seguindo os passos lá descritos.
Resposta:
Gapminder
Logo de início, a biblioteca ‘xlsx’, indicada para realizar a importação dos dados disponibilizados, não funcionou de maneira alguma, mesmo depois de pesquisas e tentativas de solucionar o problema. Então, a solução encontrada por mim foi transformar as planilhas em csv e usar a função ‘read.csv()’ do R para seguir. Mas como os dados vieram tendo como separador decimal a vírgula, a função necessária foi a ‘read.csv2()’ e isso resolveu.
Então vamos carregar os arquivos csv contendo a população, fertilidade, e expectativa de vida dos países ao longo dos anos.
population_csv <- read.csv2("indicator gapminder population.CSV", sep = ";", stringsAsFactors = FALSE)
fertility_csv <- read.csv2("indicator undata total_fertility.CSV", sep = ";", stringsAsFactors = FALSE)
lifeexp_csv <- read.csv2("indicator life_expectancy_at_birth.CSV", sep = ";", stringsAsFactors = FALSE)#Vamos criar uma variável que contenha apenas os anos de 1962 a 2015
myvars <- paste("X", 1962:2015, sep="")
#Agora vamos usar nossa variável para selecionar apenas as colunas correspondentes aos anos que a gente quer.
population <- population_csv %>% select(Total.population, all_of(myvars))
fertility <- fertility_csv %>% select(Total.fertility.rate, all_of(myvars))
lifeexp <- lifeexp_csv %>% select(Life.expectancy, all_of(myvars))#Renomeando a primeira coluna de todas as tabelas para "Country".
colnames(population)[1] <- "Country"
colnames(fertility)[1] <- "Country"
colnames(lifeexp)[1] <- "Country"
#Temos que remover as linhas vazias que foram criadas. Para isso, vamos manter apenas as primeiras 275 linhas de duas tabelas que precisam disso.
lifeexp <- lifeexp[1:275,]
population <- population[1:275,]#Vamos usar uma função da biblioteca "reshape" para transformar as colunas dos anos em linhas após o nome de cada país.
population_m <- melt(population, id=c("Country"))
lifeexp_m <- melt(lifeexp, id=c("Country"))
fertility_m <- melt(fertility, id=c("Country"))#Vamos nomear as nossas novas colunas criadas, que agora funcionam como indicador.
colnames(population_m)[3] <- "pop"
colnames(lifeexp_m)[3] <- "life"
colnames(fertility_m)[3] <- "fert"
#Transformando as três tabelas em apenas uma, com a função 'merge' juntando duas por vez.
mydf <- merge(lifeexp_m, fertility_m, by=c("Country","variable"), header =T)
mydf <- merge(mydf, population_m, by=c("Country","variable"), header =T)#Para poder mapear cada país por continente usando cores diferentes para identificarmos cada continente, vamos usar a biblioteca "gapminder":
continent <- gapminder %>% group_by(continent, country) %>% distinct(country, continent)
continent <- data.frame(lapply(continent, as.character), stringsAsFactors=FALSE)
colnames(continent)[1] <- "Country"
#Vamos usar o "dplyr" para filtrar nossa tabela 'mydf' e fazer com que ela contenha apenas os países que existem na tabela 'continent' do "gapminder":
mydf_filter <- mydf %>% filter(Country %in% unique(continent$Country))
#E então vamos juntar as tabelas 'continent' e 'mydf_filter' para que adicionemos os países aos respectivos continentes a que pertencem:
mydf_filter <- merge(mydf_filter, continent, by=c("Country"), header =T)#Por fim, vamos fazer um último trabalho de limpeza, tais como remoção de valores coagidos como NA, transformar variáveis do tipo "Factor", etc..
#Eliminando os NA's
mydf_filter[is.na(mydf_filter)] <- 0
#Alterando a coluna 'variable' de modo a remover a letra "X" antes do ano e depois transformá-lo em um número inteiro.
mydf_filter$variable <- as.integer(as.character(gsub("X","",mydf_filter$variable)))
#Mudar seu nome para "year".
colnames(mydf_filter)[colnames(mydf_filter)=="variable"] <- "year"
#Ao invés de pegarmos a população total, vamos trabalhar com a população por milhões de habitantes e apenas uam casa decimal:
mydf_filter$pop <- round(as.numeric(as.character(mydf_filter$pop))/1000000,1)
#Demonstração de como ficou a tabela final:
kable(head(mydf_filter[805:810,]), col.names = c("País", "Ano", "Expectativa de Vida", "Taxa de Fertilidade", "População (em milhões)", "Continente"), align = 'c')| País | Ano | Expectativa de Vida | Taxa de Fertilidade | População (em milhões) | Continente | |
|---|---|---|---|---|---|---|
| 805 | Brazil | 2010 | 73.6 | 1.84 | 198.6 | Americas |
| 806 | Brazil | 2011 | 73.8 | 1.82 | 200.5 | Americas |
| 807 | Brazil | 2012 | 74.0 | 1.81 | 202.4 | Americas |
| 808 | Brazil | 2013 | 74.1 | 1.80 | 204.3 | Americas |
| 809 | Brazil | 2014 | 74.3 | 1.79 | 206.1 | Americas |
| 810 | Brazil | 2015 | 74.4 | 1.78 | 207.8 | Americas |
E, finalmente, o Gráfico!
# Criar um tema global para o nosso 'plot'
theme_set(theme_grey()+ theme(legend.box.background = element_rect(),legend.box.margin = margin(6, 6, 6, 6)) )
# O nosso gráfico vai conter os anos como cada frame da animação, limitando o eixo y (da expectativa de vida) de 30 anos até 100, para termos uma boa visualização.
p <- ggplot(mydf_filter, aes(fert, life, size = pop, color = continent, frame = year)) +
labs(x="Fertility Rate", y = "Life expectancy at birth (years)",
####-------------------------Pequena contribuição------------------------------------------####
caption = "(Based on data from Hans Rosling - gapminder.com)\nReproduced by Germano Andrade",
#--------------------------------------------------------------------------------------------#
color = 'Continent',size = "Population (millions)") +
ylim(30,100) +
geom_point() +
scale_color_brewer(type = 'div', palette = 'Spectral') +
# gganimate code
ggtitle("Year: {frame_time}") +
transition_time(year) +
ease_aes("linear") +
enter_fade() +
exit_fade()# animate
animate(p, width = 450, height = 450)
# save as a GIF
anim_save("Gapminder-Germano_Andrade.gif")# Criar um gráfico para o plotly
p <- ggplot(mydf_filter, aes(fert, life, size = pop, color = continent, frame = year)) +
geom_point()+ ylim(30,100) + labs(x="Fertility Rate", y = "Life expectancy at birth (years)", color = 'Continent',size = "Population (millions)") +
scale_color_brewer(type = 'div', palette = 'Spectral')
# Gerar a Visualização e a saída em HTML para ser salva;
ggp <- ggplotly(p, height = 900, width = 900) %>%
animation_opts(frame = 100,
easing = "linear",
redraw = FALSE)
ggphtmlwidgets::saveWidget(ggp, "index.html")Problema 4: Atirei o pau no gráfico
Assista o vídeo https://www.youtube.com/watch?v=CJkzf4IZRuk em que o autor realiza um gráfico em Excel. Seguindo os mesmos passos, faça esse gráfico em R.
Resposta:
Atirei o pau no gráfico
tab_covid <- read.csv("HIST_PAINEL_COVIDBR_18mai2020.CSV", sep = ";",stringsAsFactors = FALSE)# Alterando a coluna 'data' para que o R reconheça como uma data:
tab_covid$data <- as.Date(tab_covid$data, "%d/%m/%y")# Filtrando os óbitos acumulados por data até o dia 18/05/2020:
Sars_CoV_2 <- tab_covid %>% group_by(data, obitosAcumulado) %>% distinct(data, obitosAcumulado)
Sars_CoV_2 <- Sars_CoV_2[21:83,](c1 <- ggplot(Sars_CoV_2, aes(x = data, y = obitosAcumulado)) +
geom_point(color = "mediumblue") +
geom_path(color = "mediumblue", size = 1) +
theme_light() +
labs(title = "total de óbitos", x = NULL, y = NULL, caption = "(https://covid.saude.gov.br/)\nRetrieved on 19 May 2020."))
(c1 +
scale_y_continuous(trans = 'log10') +
labs(title = "total de óbitos (escala logarítmica)"))
# taxa de crescimento = valor no dia/valor no dia anterior
dias <- 63
taxa <- vector(length = dias)# Criando um vetor vazio;
taxa[1] <- 0
for (i in 1:(dias-1)){
taxa[i+1] <- (Sars_CoV_2$obitosAcumulado[i+1]/Sars_CoV_2$obitosAcumulado[i])
}
# Adicionando a coluna da taxa de crescimento
Sars_CoV_2 <- data.frame(data = Sars_CoV_2$data,
obitosAcumulado = Sars_CoV_2$obitosAcumulado,
taxa = taxa)
#Criando uma base que contenha apenas os dados a partir do dia 27/03/2020, porque é mais interessante observar a taxa de crescimento nesse período:
Sel_Sars <- Sars_CoV_2[11:63,]ay <- list(
tickfont = list(color = "red"),
overlaying = "y",
side = "right",
title = "Taxa"
)
fig <- plot_ly()
fig <- fig %>% add_lines(data = Sel_Sars, x = Sel_Sars$data, y = Sel_Sars$obitosAcumulado, yaxis = "y1", name = "Óbitos acumulados")
fig <- fig %>% add_lines(x = Sel_Sars$data, y = Sel_Sars$taxa, name = "Taxa de crescimento", yaxis = "y2")
fig <- fig %>% layout(
title = "total de óbitos", yaxis = list(type = "log", title = "Escala logarítmica"),
yaxis2 = ay,
xaxis = list(title=NULL)
)
fig#Calculando a soma acumulada:
dias <- 53
media <- 1.05
s_acum <- vector(length = dias)# Criando um vetor vazio;
s_acum[1] <- Sel_Sars$taxa[1]-media
for (i in 1:(dias-1)){
s_acum[i+1] <- (Sel_Sars$taxa[i+1]-media+s_acum[i])
}
#s_acum
#Sel_Sars <- data.frame(data = Sel_Sars$data,
# obitosAcumulado = Sel_Sars$obitosAcumulado,
#taxa = Sel_Sars$taxa,
#soma = s_acum)
ggplot(Sel_Sars, aes(x = data, y = s_acum)) +
geom_point(color = "mediumblue") +
geom_path(color = "mediumblue", size = 1) +
geom_line(aes(y = s_acum[53]), col = "red") +
theme_light()
data <- c("19/05/2020", "20/05/2020", "21/05/2020", "22/05/2020", "23/05/2020", "24/05/2020", "25/05/2020", "26/05/2020", "27/05/2020", "28/05/2020", "29/05/2020", "30/05/2020", "31/05/2020")
taxa_1 <- rep(media, 13)
#teste <- rbind(teste, )taxa_1 <- rep(media, 13)m <- 13
casos <- vector(length = m)# Criando um vetor vazio;
casos[1] <- Sel_Sars$obitosAcumulado[53]*media
for (i in 1:(m-1)){
casos[i+1] <- (casos[i]*media)
}
casos <- round(casos,0)Previ <- data.frame("data" = data,
"obitosAcumulado" = casos,
"taxa" = taxa_1, stringsAsFactors = FALSE)
Previ$data <- as.Date(Previ$data, "%d/%m/%y")
Previs <- rbind(Sel_Sars, Previ)ggplot(Previs, aes(x = data, y = obitosAcumulado)) +
geom_point(color = "mediumblue") +
geom_path(color = "mediumblue", size = 1) +
theme_light() +
labs(title = "total de óbitos", x = NULL, y = NULL, caption = "(https://covid.saude.gov.br/)\nRetrieved on 19 May 2020.") +
scale_y_continuous(trans = 'log10') +
labs(title = "Previsão de Óbitos (escala logarítmica)")